;; -*-Lisp-*-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; File:         xdpyinfo.lsp
; RCS:          $Header: /users/npm/src/widgit/examples/lib-utils/RCS/unixstuf.lsp,v 2.2 1995/02/01 10:26:03 npm Exp npm $
; Description:  Module to Fetch Display Parameters (xdpyinfo)
;		GET-DISPLAY-DIMENSIONS-STRING GET-DISPLAY-RESOLUTION-STRING
; Author:       Niels P. Mayer
; Created:      Feb 20, 1996
; Modified:     Tue Feb 20 15:33:45 1996 (Niels Mayer) npm@mayer.eit.com
; Language:     Lisp
; Package:      N/A
; Status:       X11r6 contrib release
;
; Copyright (C) 1994, Enterprise Integration Technologies Corp. and Niels Mayer.
; WINTERP 1.15-1.99, Copyright (c) 1993, Niels P. Mayer.
; WINTERP 1.0-1.14, Copyright (c) 1989-1992 Hewlett-Packard Co. and Niels Mayer.
; 
; Permission to use, copy, modify, distribute, and sell this software and its
; documentation for any purpose is hereby granted without fee, provided that
; the above copyright notice appear in all copies and that both that
; copyright notice and this permission notice appear in supporting
; documentation, and that the name of Enterprise Integration Technologies,
; Hewlett-Packard Company, or Niels Mayer not be used in advertising or
; publicity pertaining to distribution of the software without specific,
; written prior permission. Enterprise Integration Technologies, Hewlett-Packard
; Company, and Niels Mayer makes no representations about the suitability of
; this software for any purpose.  It is provided "as is" without express or
; implied warranty.
; 
; ENTERPRISE INTEGRATION TECHNOLOGIES, HEWLETT-PACKARD COMPANY AND NIELS MAYER
; DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL IMPLIED
; WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL ENTERPRISE
; INTEGRATION TECHNOLOGIES, HEWLETT-PACKARD COMPANY OR NIELS MAYER BE LIABLE
; FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
; RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
; CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN
; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(in-package "WINTERP")

(export '(
	  get-display-resolution-string
	  get-display-dimensions-string
	  get-display-dimension-pair
	  get-display-resolution-pair
	  ))

(defvar winterp::*XDPYINFO-PROC* "/usr/bin/X11/xdpyinfo")
(cond
 ((open winterp::*XDPYINFO-PROC* :direction :probe)
  ;; Default winterp::*XDPYINFO-PROC* is ok on this system -- do nothing
  )
 (T
  ;; Default winterp::*XDPYINFO-PROC* locaiton doesn't exist -- hope user has
  ;; $PATH set correctly to resolve this...
  (setq winterp::*XDPYINFO-PROC* "xdpyinfo")
  ))

;;; For Irix (SGI Indy R4000SC w/ 17" monitor)
;;;  dimensions:    1280x1024 pixels (293x234 millimeters)
;;;  resolution:    111x111 dots per inch
;;;
;;; For Linux, xpdyinfo outputs:
;;;  dimensions:    1024x768 pixels (347x260 millimeters)
;;;  resolution:    75x75 dots per inch

(let ((disp-res NIL)
      (disp-dim NIL)
      )

  (defun winterp::_get-xpdyinfo ()
    (let ((xdpyinfo-pipe
	   (popen winterp::*XDPYINFO-PROC* :direction :input))
	  )
      (unwind-protect
	  (progn
	    (do ((line (read-line xdpyinfo-pipe nil)
		       (read-line xdpyinfo-pipe nil)))
		((or (null line)
		     (and (> (length line) 13)
			  (string= "  dimensions:" line
				   :start1 0 :start2 0
				   :end1 13 :end2 13))
		     )
		 (if line
		     (setq disp-dim
			   (string-left-trim " "
					     (subseq line 13 nil))))
		 )
		)
	    (do ((line (read-line xdpyinfo-pipe nil)
		       (read-line xdpyinfo-pipe nil)))
		((or (null line)
		     (and (> (length line) 13)
			  (string= "  resolution:" line
				   :start1 0 :start2 0
				   :end1 13 :end2 13))
		     )
		 (if line
		     (setq disp-res
			   (string-left-trim " "
					     (subseq line 13 nil))))
		 )
		)
	    )
	;; Unwind protect -- always close the pipe, even in case of error.
	(pclose xdpyinfo-pipe)
	)
      )
    )

  (defun get-display-resolution-string ()
    (cond
     (disp-res
      disp-res				;RETURN
      )
     (T
      (winterp::_get-xpdyinfo)
      disp-res				;RETURN
      )
     )
    )

  (defun get-display-dimensions-string ()
    (cond
     (disp-dim
      disp-dim				;RETURN
      )
     (T
      (winterp::_get-xpdyinfo)
      disp-dim				;RETURN
      )
     )
    )
  )

(defun get-display-dimension-pair ()
  (let ((dim (winterp:get-display-dimensions-string)))
    (setq dim
	  (subseq dim 0 (search " " dim)))
    (let ((sepidx (search "x" dim)))
      (if sepidx
	  ;; success -- return dimensions as pair of fixnums
	  (cons (read (make-string-input-stream
		       (subseq dim 0 sepidx)))
		(read (make-string-input-stream
		       (subseq dim (1+ sepidx) nil)))
		)
	;; Failed -- return dimension string
	dim
	)
      )
    )
  )
(defun get-display-resolution-pair ()
  (let ((res (winterp:get-display-resolution-string)))
    (setq res
	  (subseq res 0 (search " " res)))
    (let ((sepidx (search "x" res)))
      (if sepidx
	  ;; success -- return dimensions as pair of fixnums
	  (cons (read (make-string-input-stream
		       (subseq res 0 sepidx)))
		(read (make-string-input-stream
		       (subseq res (1+ sepidx) nil)))
		)
	;; Failed -- return dimension string
	res
	)
      )
    )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(provide "lib-utils/xdpyinfo")

